; compile like this:
; .r ncompl
; elfer.lap(kt)
; and load like this:
; (faz ↓elfer.fas[gra,aam])
;
; the compilation can be done by saying "do n" while aliased to [s,he]
;  and the loading can be done by including the faz in an .acr file used
;  for initialization by acronym

(DECLARE (FASLAPSETUP/| T))

(LAP ELFER)        
(DEFSYM ELFCHAN 0)
(DEFSYM GRNCHAN 0)

; code from RPG to find a free channel...
; this subroutine finds a free channel in the chntb, marks it as being in
;  use, and then returns the channel, shifted into the right position to
;  be ior'ed into an instruction, in the tt register.
;  it also returns the channel, unshifted, in the ar1 register.
getchan
	(move tt point)
loop1
	(move ar1 0 tt) ; look for a zero entry in chntb
	(jumpe ar1 found)
	(aobjn tt loop1)
	(lerr 0 (% sixbit |No channels available!|))
found
	(movsi ar1 400000) ; set sign bit in chntb entry (mark channel used)
	(movem ar1 0 tt)
	(hrrzs 0 tt) 
	(subi tt chntb)
	(movei ar1 0 tt) ; get unshifted channel in ar1
	(lsh tt 27) ; and shifted one in tt
	(popj p)
point	(77776←25 0 chntb)              ;-20,,chntb

; release a channel (clear its entry in chntb).  channel number is in ar1
relchan
	(setzm 0 chntb ar1)
	(movei a 't)
	(popj p)

; ELFINI.  Opens the ELF on a free channel.
; returns T if it worked, Nil if it didn't.  Don't call it more than once.
(ENTRY ELFINI SUBR)
(ARGS ELFINI (NIL . 0))
; get a free channel
	(PUSHJ P GETCHAN)
; save channel in instructions that will use it
	(IORM TT INS1)
	(IORM TT INS2)
	(IORM TT INS3)
	(IORM TT INS4)
	(IORM TT INS5)
	(IORM TT INS6)
	(IORM TT INS7)
	(IORM TT INS8)
	(IORM TT INS9)
	(IORM TT INSA)
; save actual channel number
	(movem ar1 echan)
; now open the elf
INS1 ; this instruction is modified!
	(OPEN ELFCHAN ELF-OPEN-BLOCK)
	(SKIPA A (% 0 0 'NIL))	; lose
	(MOVEI A 'T)		; success
	(POPJ P)		; return
ELF-OPEN-BLOCK
	(17)			; dump mode
	(455446←22)		; SIXBIT/ELF/
	(0)
echan	(0)

; RISKON.  Turns on risky-mode I/O to the elf (faster)
(ENTRY RISKON SUBR)
(ARGS RISKON (NIL . 0))
INS7 ; this instruction is modified!
	(GETSTS ELFCHAN ELF-STATUS)
	(MOVE TT ELF-STATUS)
	(TRO TT 400) ;turn on risky mode in status
	(HRRM TT INS8)
INS8 ; this instruction is modified--twice!
	(060000←22) ; SETSTS ELFCHAN,0
	(MOVEI A 'T)
	(POPJ P)

ELF-STATUS	(0)

; RISKOFF.  Turns off risky-mode I/O to the elf (faster)
(ENTRY RISKOFF SUBR)
(ARGS RISKOFF (NIL . 0))
INS9 ; this instruction is modified!
	(GETSTS ELFCHAN ELF-STATUS)
	(MOVE TT ELF-STATUS)
	(TRZ TT `400) ;turn on risky mode in status
	(HRRM TT INSA)
INSA ; this instruction is modified--twice!
	(060000←22) ; SETSTS ELFCHAN,0
	(MOVEI A 'T)
	(POPJ P)

; ELFREL.  Releases the ELF (after being set up by ELFINI)
(ENTRY ELFREL SUBR)
(ARGS ELFREL (NIL . 0))
INS2 ; this instruction is modified!
	(RELEAS ELFCHAN)
	(MOVE AR1 ECHAN)
	(JRST 0 RELCHAN) ; (POPJ P)

; ELFIN.  Inputs one word from the pdp-11 and returns it.  Call with (ELFIN ADDR)
; note that ELFIN takes a WORD address, but 11TTY works with byte addresses.
(ENTRY ELFIN SUBR)
(ARGS ELFIN (NIL . 1))
	(MOVE A 0 A)		; get first arg (fixnum)
	(HRRM A PEEK-BLOCK)	; save it as addr to peek at
INS3 ; this instruction is modified!
	(MTAPE ELFCHAN PEEK-BLOCK)  ; do the peek
	(SKIPA TT (% 0))	; return 0 if nothing there
	(MOVE TT (+ PEEK-BLOCK 1))
	(JRST 0 FIX1)		; return a fixnum
PEEK-BLOCK
	(2000←22)	; peek function
	(BLOCK 1)		; data word

; ELFOUT.  Opposite of elfin.  Call with (ELFOUT ADDR WORD)
(ENTRY ELFOUT SUBR)
(ARGS ELFOUT (NIL . 2))
	(MOVE A 0 A)		; get args
	(MOVE B 0 B)
	(HRRM A POKE-BLOCK)	; and do something with them
	(MOVEM B (+ POKE-BLOCK 1))
INS4 ; this instruction is modified!
	(MTAPE ELFCHAN POKE-BLOCK)
	(JFCL)
	(POPJ P)
POKE-BLOCK
	(3000←22)	; poke function
	(BLOCK 1)		; data word

; ELFBKO.  Does a block-mode elfout.  Call with (ELFBKO ADDR ARRAY)
(ENTRY ELFBKO SUBR)
(ARGS ELFBKO (NIL . 2))
	(MOVE A 0 A)		; get addr
	(TRO A 400000)		; set "unibus address" bit
	(TLO A 400000)		; also set mode to 1 11 word per 10 word, right just
INS5 ; this instruction is modified!
	(USETO ELFCHAN A)	; set unibus output addr
	(MOVE B 1 B)		; get addr of array
	(SUBI B 1)		; set up iowd
	(MOVEM B IO-WORD)
	(MOVN B 0 B)		; get -length of array
	(HRLM B IO-WORD)	; finish iowd
INS6 ; this instruction is modified!
	(OUTPUT ELFCHAN IO-WORD) ; splat
	(POPJ P)
IO-WORD	(BLOCK 1)

; CLICK. Clicks the horton box...argument determines which color, 4=red 2=green 1=blue
(ENTRY CLICK SUBR)
(ARGS CLICK (NIL . 1))
	(CALLI 0 400005) ; eiotm
	(MOVE A 0 A)
	(LSH A 13.)
	(MOVE B A)
	(IOR B CON1)
	(XCT 0 B)	; click on
	(MOVEI C 1)	; wait one sec
	(CALLI C 31) ; sleep uuo
	(MOVE B A)
	(IOR B CON2)
	(XCT 0 B)
	(CALLI 0 400006) ; liotm
	(POPJ P)
CON1	(735600←22)	   ; CONO CAR,0
CON2	(735600←22 0 400000) ; CONO CAR,400000


; GRNINI.  Opens device GRN on a free channel.
; returns T if it worked, Nil if it didn't.  Don't call it more than once.
(ENTRY GRNINI SUBR)
(ARGS GRNINI (NIL . 0))
	(PUSHJ P GETCHAN)
; alter the necessary instructions, and save channel number
	(IORM TT INSB)
	(IORM TT INSC)
	(MOVEM AR1 GCHAN)
; now open the grn
INSB ; this instruction is modified!
	(OPEN GRNCHAN GRN-OPEN-BLOCK)
	(SKIPA A (% 0 0 'NIL))	; lose
	(MOVEI A 'T)		; success
	(POPJ P)		; return
GRN-OPEN-BLOCK
	(0)			; ascii mode
	(476256←22)		; SIXBIT/GRN/
	(0)
gchan	(0)

; GRNREL.  Releases the GRN (after being set up by GRNINI)
(ENTRY GRNREL SUBR)
(ARGS GRNREL (NIL . 0))
INSC ; this instruction is modified!
	(RELEAS GRNCHAN)
	(MOVE AR1 GCHAN)
	(JRST 0 RELCHAN) ; (POPJ P)

NIL